home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / x11 / x-toolbar.el.z / x-toolbar.el
Encoding:
Text File  |  1998-05-21  |  15.8 KB  |  484 lines
  1. ;;; x-toolbar.el -- Runtime initialization of XEmacs toolbar
  2. ;; Copyright (C) 1997 Free Software Foundation, Inc.
  3. ;; Copyright (C) 1994 Andy Piper <andyp@parallax.demon.co.uk>
  4. ;; Copyright (C) 1995 Board of Trustees, University of Illinois
  5. ;; Copyright (C) 1996 Ben Wing <wing@666.com>
  6.  
  7. ;; Maintainer: XEmacs development team
  8. ;; Keywords: frames
  9.  
  10. ;; This file is part of XEmacs.
  11.  
  12. ;; XEmacs is free software; you can redistribute it and/or modify it
  13. ;; under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; XEmacs is distributed in the hope that it will be useful, but
  18. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20. ;; General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  24. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25. ;; Boston, MA 02111-1307, USA.
  26.  
  27. ;;; Synched up:  Not in FSF
  28.  
  29. ;;; Commentary:
  30.  
  31. ;; Miscellaneous toolbar functions, useful for users to redefine, in
  32. ;; order to get different behaviour.
  33.  
  34. ;;; Code:
  35.  
  36. (eval-when-compile
  37.   (require 'pending-del))
  38.  
  39. (defgroup toolbar nil
  40.   "Configure XEmacs Toolbar functions and properties"
  41.   :group 'environment)
  42.  
  43.  
  44. (defun toolbar-not-configured ()
  45.   (ding)
  46.   (message "Configure the item via `M-x customize RET toolbar RET'"))
  47.  
  48. (defcustom toolbar-open-function 'find-file
  49.   "*Function to call when the open icon is selected."
  50.   :type '(radio (function-item find-file)
  51.                 (function :tag "Other"))
  52.   :group 'toolbar)
  53.  
  54. (defun toolbar-open ()
  55.   (interactive)
  56.   (call-interactively toolbar-open-function))
  57.  
  58. (defcustom toolbar-dired-function 'dired
  59.   "*Function to call when the dired icon is selected."
  60.   :type '(radio (function-item dired)
  61.                 (function :tag "Other"))
  62.   :group 'toolbar)
  63.  
  64. (defun toolbar-dired ()
  65.   (interactive)
  66.   (call-interactively toolbar-dired-function))
  67.  
  68. (defcustom toolbar-save-function 'save-buffer
  69.   "*Function to call when the save icon is selected."
  70.   :type '(radio (function-item save-buffer)
  71.                 (function :tag "Other"))
  72.   :group 'toolbar)
  73.  
  74. (defun toolbar-save ()
  75.   (interactive)
  76.   (call-interactively toolbar-save-function))
  77.  
  78. (defcustom toolbar-print-function 'lpr-buffer
  79.   "*Function to call when the print icon is selected."
  80.   :type '(radio (function-item lpr-buffer)
  81.                 (function :tag "Other"))
  82.   :group 'toolbar)
  83.  
  84. (defun toolbar-print ()
  85.   (interactive)
  86.   (call-interactively toolbar-print-function))
  87.  
  88. (defcustom toolbar-cut-function 'x-kill-primary-selection
  89.   "*Function to call when the cut icon is selected."
  90.   :type '(radio (function-item x-kill-primary-selection)
  91.                 (function :tag "Other"))
  92.   :group 'toolbar)
  93.  
  94. (defun toolbar-cut ()
  95.   (interactive)
  96.   (call-interactively toolbar-cut-function))
  97.  
  98. (defcustom toolbar-copy-function 'x-copy-primary-selection
  99.   "*Function to call when the copy icon is selected."
  100.   :type '(radio (function-item x-copy-primary-selection)
  101.                 (function :tag "Other"))
  102.   :group 'toolbar)
  103.  
  104. (defun toolbar-copy ()
  105.   (interactive)
  106.   (call-interactively toolbar-copy-function))
  107.  
  108. (defcustom toolbar-paste-function 'x-yank-clipboard-selection
  109.   "*Function to call when the paste icon is selected."
  110.   :type '(radio (function-item x-yank-clipboard-selection)
  111.                 (function :tag "Other"))
  112.   :group 'toolbar)
  113.  
  114. (defun toolbar-paste ()
  115.   (interactive)
  116.   ;; This horrible kludge is for pending-delete to work correctly.
  117.   (and (boundp 'pending-delete)
  118.        pending-delete
  119.        (let ((this-command toolbar-paste-function))
  120.      (pending-delete-pre-hook)))
  121.   (call-interactively toolbar-paste-function))
  122.  
  123. (defcustom toolbar-undo-function 'undo
  124.   "*Function to call when the undo icon is selected."
  125.   :type '(radio (function-item undo)
  126.                 (function :tag "Other"))
  127.   :group 'toolbar)
  128.  
  129. (defun toolbar-undo ()
  130.   (interactive)
  131.   (call-interactively toolbar-undo-function))
  132.  
  133. (defcustom toolbar-replace-function 'query-replace
  134.   "*Function to call when the replace icon is selected."
  135.   :type '(radio (function-item query-replace)
  136.                 (function :tag "Other"))
  137.   :group 'toolbar)
  138.  
  139. (defun toolbar-replace ()
  140.   (interactive)
  141.   (call-interactively toolbar-replace-function))
  142.  
  143. ;;
  144. ;; toolbar ispell variables and defuns
  145. ;;
  146.  
  147. (defun toolbar-ispell-internal ()
  148.   (interactive)
  149.   (cond
  150.    ((region-active-p) (ispell-region (region-beginning) (region-end)))
  151.    ((eq major-mode 'mail-mode) (ispell-message))
  152.    ((eq major-mode 'message-mode) (ispell-message))
  153.    (t (ispell-buffer))))
  154.  
  155. (defcustom toolbar-ispell-function 'toolbar-ispell-internal
  156.   "*Function to call when the ispell icon is selected."
  157.   :type '(radio (function-item toolbar-ispell-internal)
  158.         (function :tag "Other"))
  159.   :group 'toolbar)
  160.  
  161. (defun toolbar-ispell ()
  162.   "Intelligently spell the region or buffer."
  163.   (interactive)
  164.   (call-interactively toolbar-ispell-function))
  165.  
  166. ;;
  167. ;; toolbar mail variables and defuns
  168. ;;
  169.  
  170. ;; This used to be a macro that expanded its arguments to a form that
  171. ;; called `call-process'.  With the advent of customize, it's better
  172. ;; to have it as a defun, to make customization easier.
  173. (defun toolbar-external (process &rest args)
  174.   (interactive)
  175.   (apply 'call-process process nil 0 nil args))
  176.  
  177. (defcustom toolbar-mail-commands-alist
  178.   `((not-configured . toolbar-not-configured)
  179.     (vm        . vm)
  180.     (gnus    . gnus-no-server)
  181.     (rmail    . rmail)
  182.     (mh        . mh-rmail)
  183.     (pine    . (toolbar-external "xterm" "-e" "pine")) ; *gag*
  184.     (elm    . (toolbar-external "xterm" "-e" "elm"))
  185.     (mutt    . (toolbar-external "xterm" "-e" "mutt"))
  186.     (exmh    . (toolbar-external "exmh"))
  187.     (netscape    . (toolbar-external "netscape" "mailbox:"))
  188.     (send    . mail))
  189.   "*Alist of mail readers and their commands.
  190. The car of each alist element is the mail reader, and the cdr is the form
  191. used to start it."
  192.   :type '(repeat (cons :format "%v"
  193.                (symbol :tag "Mailer") (function :tag "Start with")))
  194.   :group 'toolbar)
  195.  
  196. (defcustom toolbar-mail-reader 'not-configured
  197.   "*Mail reader toolbar will invoke.
  198. The legal values are the keys from `toolbar-mail-command-alist', which
  199.  should be used to add new mail readers.
  200. Mail readers known by default are vm, gnus, rmail, mh, pine, elm,
  201.  mutt, exmh, netscape and send."
  202.   :type '(choice (const :tag "Not Configured" not-configured)
  203.          (const vm) (const gnus) (const rmail) (const mh)
  204.          (const pine) (const elm) (const mutt) (const exmh)
  205.          (const netscape)
  206.                  (const send)
  207.          (symbol :tag "Other"
  208.              :validate (lambda (wid)
  209.                      (if (assq (widget-value wid)
  210.                            toolbar-mail-commands-alist)
  211.                      nil
  212.                        (widget-put wid :error
  213.                            "Unknown mail reader")
  214.                        wid))))
  215.   :group 'toolbar)
  216.  
  217.  
  218. (defun toolbar-mail ()
  219.   "Run mail in a separate frame."
  220.   (interactive)
  221.   (let ((command (cdr (assq toolbar-mail-reader toolbar-mail-commands-alist))))
  222.     (if (not command)
  223.     (error "Uknown mail reader %s" toolbar-mail-reader))
  224.     (if (symbolp command)
  225.     (call-interactively command)
  226.       (eval command))))
  227.  
  228. ;;
  229. ;; toolbar info variables and defuns
  230. ;;
  231.  
  232. (defvar toolbar-info-frame nil
  233.   "The frame in which info is displayed.")
  234.  
  235. (defcustom Info-frame-plist 
  236.     (append (list 'width 80)
  237.         (let ((h (plist-get default-frame-plist 'height)))
  238.           (when h (list 'height h))))
  239.     "Frame plist for the Info frame."
  240.   :type '(repeat (group :inline t
  241.           (symbol :tag "Property")
  242.           (sexp :tag "Value")))
  243.   :group 'info)
  244.  
  245. (defun toolbar-info ()
  246.   "Run info in a separate frame."
  247.   (interactive)
  248.   (if (or (not toolbar-info-frame)
  249.       (not (frame-live-p toolbar-info-frame)))
  250.       (progn
  251.     (setq toolbar-info-frame (make-frame Info-frame-plist))
  252.     (select-frame toolbar-info-frame)
  253.     (raise-frame toolbar-info-frame)))
  254.   (if (frame-iconified-p toolbar-info-frame)
  255.       (deiconify-frame toolbar-info-frame))
  256.   (select-frame toolbar-info-frame)
  257.   (raise-frame toolbar-info-frame)
  258.   (info))
  259.  
  260. ;;
  261. ;; toolbar debug variables and defuns
  262. ;;
  263.  
  264. (defun toolbar-debug ()
  265.   (interactive)
  266.   (if (featurep 'eos-debugger)
  267.       (call-interactively 'eos::start-debugger)
  268.     (require 'gdbsrc)
  269.     (call-interactively 'gdbsrc)))
  270.  
  271. (defvar compile-command)
  272.  
  273. (defun toolbar-compile ()
  274.   "Run compile without having to touch the keyboard."
  275.   (interactive)
  276.   (require 'compile)
  277.   (popup-dialog-box
  278.    `(,(concat "Compile:\n        " compile-command)
  279.      ["Compile" (compile compile-command) t]
  280.      ["Edit command" compile t]
  281.      nil
  282.      ["Cancel" (message "Quit") t])))
  283.  
  284. ;;
  285. ;; toolbar news variables and defuns
  286. ;;
  287.  
  288. (defcustom toolbar-news-commands-alist
  289.   `((not-configured . toolbar-not-configured)
  290.     (gnus    . toolbar-gnus)            ; M-x all-hail-gnus
  291.     (rn        . (toolbar-external "xterm" "-e" "rn"))
  292.     (nn        . (toolbar-external "xterm" "-e" "nn"))
  293.     (trn    . (toolbar-external "xterm" "-e" "trn"))
  294.     (xrn    . (toolbar-external "xrn"))
  295.     (slrn    . (toolbar-external "xterm" "-e" "slrn"))
  296.     (pine    . (toolbar-external "xterm" "-e" "pine")) ; *gag*
  297.     (tin    . (toolbar-external "xterm" "-e" "tin")) ; *gag*
  298.     (netscape    . (toolbar-external "netscape" "news:")))
  299.   "*Alist of news readers and their commands.
  300. The car of each alist element the pair is the news reader, and the cdr
  301. is the form used to start it."
  302.   :type '(repeat (cons :format "%v"
  303.                (symbol :tag "Reader") (sexp :tag "Start with")))
  304.   :group 'toolbar)
  305.  
  306. (defcustom toolbar-news-reader 'not-configured
  307.   "*News reader toolbar will invoke.
  308. The legal values are the keys from `toolbar-news-command-alist', which should
  309.  be used to add new news readers.
  310. Newsreaders known by default are gnus, rn, nn, trn, xrn, slrn, pine
  311.  and netscape."
  312.   :type '(choice (const :tag "Not Configured" not-configured)
  313.          (const gnus) (const rn) (const nn) (const trn)
  314.          (const xrn) (const slrn) (const pine) (const tin)
  315.          (const netscape)
  316.          (symbol :tag "Other"
  317.              :validate (lambda (wid)
  318.                      (if (assq (widget-value wid)
  319.                            toolbar-news-commands-alist)
  320.                      nil
  321.                        (widget-put wid :error
  322.                            "Unknown news reader")
  323.                        wid))))
  324.   :group 'toolbar)
  325.  
  326. (defcustom toolbar-news-use-separate-frame t
  327.   "*Whether Gnus is invoked in a separate frame."
  328.   :type 'boolean
  329.   :group 'toolbar)
  330.  
  331. (defvar toolbar-news-frame nil
  332.   "The frame in which news is displayed.")
  333.  
  334. (defvar toolbar-news-frame-properties nil
  335.   "The properties of the frame in which news is displayed.")
  336.  
  337. (defun toolbar-gnus ()
  338.   "Run Gnus in a separate frame."
  339.   (interactive)
  340.   (if (not toolbar-news-use-separate-frame)
  341.       (gnus)
  342.     (unless (frame-live-p toolbar-news-frame)
  343.       (setq toolbar-news-frame (make-frame toolbar-news-frame-properties))
  344.       (add-hook 'gnus-exit-gnus-hook
  345.         (lambda ()
  346.           (when (frame-live-p toolbar-news-frame)
  347.             (if (cdr (frame-list))
  348.             (delete-frame toolbar-news-frame))
  349.             (setq toolbar-news-frame nil))))
  350.       (select-frame toolbar-news-frame)
  351.       (raise-frame toolbar-news-frame)
  352.       (gnus))
  353.     (when (framep toolbar-news-frame)
  354.       (when (frame-iconified-p toolbar-news-frame)
  355.     (deiconify-frame toolbar-news-frame))
  356.       (select-frame toolbar-news-frame)
  357.       (raise-frame toolbar-news-frame))))
  358.  
  359. (defun toolbar-news ()
  360.   "Run News (in a separate frame??)."
  361.   (interactive)
  362.   (let ((command (assq toolbar-news-reader toolbar-news-commands-alist)))
  363.     (if (not command)
  364.     (error "Unknown news reader %s" toolbar-news-reader))
  365.     (funcall (cdr command))))
  366.  
  367. (defvar toolbar-last-win-icon nil "A `last-win' icon set.")
  368. (defvar toolbar-next-win-icon nil "A `next-win' icon set.")
  369. (defvar toolbar-file-icon     nil "A `file' icon set.")
  370. (defvar toolbar-folder-icon   nil "A `folder' icon set")
  371. (defvar toolbar-disk-icon     nil "A `disk' icon set.")
  372. (defvar toolbar-printer-icon  nil "A `printer' icon set.")
  373. (defvar toolbar-cut-icon      nil "A `cut' icon set.")
  374. (defvar toolbar-copy-icon     nil "A `copy' icon set.")
  375. (defvar toolbar-paste-icon    nil "A `paste' icon set.")
  376. (defvar toolbar-undo-icon     nil "An `undo' icon set.")
  377. (defvar toolbar-spell-icon    nil "A `spell' icon set.")
  378. (defvar toolbar-replace-icon  nil "A `replace' icon set.")
  379. (defvar toolbar-mail-icon     nil "A `mail' icon set.")
  380. (defvar toolbar-info-icon     nil "An `info' icon set.")
  381. (defvar toolbar-compile-icon  nil "A `compile' icon set.")
  382. (defvar toolbar-debug-icon    nil "A `debugger' icon set.")
  383. (defvar toolbar-news-icon     nil "A `news' icon set.")
  384.  
  385. ;;; each entry maps a variable to the prefix used.
  386.  
  387. (defvar init-x-toolbar-list
  388.   '((toolbar-last-win-icon . "last-win")
  389.     (toolbar-next-win-icon . "next-win")
  390.     (toolbar-file-icon     . "file")
  391.     (toolbar-folder-icon   . "folder")
  392.     (toolbar-disk-icon     . "disk")
  393.     (toolbar-printer-icon  . "printer")
  394.     (toolbar-cut-icon      . "cut")
  395.     (toolbar-copy-icon     . "copy")
  396.     (toolbar-paste-icon    . "paste")
  397.     (toolbar-undo-icon     . "undo")
  398.     (toolbar-spell-icon    . "spell")
  399.     (toolbar-replace-icon  . "replace")
  400.     (toolbar-mail-icon     . "mail")
  401.     (toolbar-info-icon     . "info-def")
  402.     (toolbar-compile-icon  . "compile")
  403.     (toolbar-debug-icon    . "debug")
  404.     (toolbar-news-icon     . "news")))
  405.  
  406. (defun init-x-toolbar ()
  407.   (toolbar-add-item-data init-x-toolbar-list )
  408.   ;; do this now because errors will occur if the icon symbols
  409.   ;; are not initted
  410.   (set-specifier default-toolbar initial-toolbar-spec))
  411.   
  412. (defun toolbar-add-item-data ( icon-list &optional icon-dir )
  413.   (if (eq icon-dir nil)
  414.       (setq icon-dir toolbar-icon-directory))
  415.   (mapcar
  416.    (lambda (cons)
  417.      (let ((prefix (expand-file-name (cdr cons)  icon-dir)))
  418.        (set (car cons)
  419.         (if (featurep 'xpm)
  420.         (toolbar-make-button-list
  421.          (concat prefix "-up.xpm")
  422.          nil
  423.          (concat prefix "-xx.xpm")
  424.          (concat prefix "-cap-up.xpm")
  425.          nil
  426.          (concat prefix "-cap-xx.xpm"))
  427.           (toolbar-make-button-list
  428.            (concat prefix "-up.xbm")
  429.            (concat prefix "-dn.xbm")
  430.            (concat prefix "-xx.xbm")
  431.            )))))
  432.    icon-list  )
  433.   )
  434.  
  435. (defvar initial-toolbar-spec
  436.   '(;;[toolbar-last-win-icon    pop-window-configuration
  437.     ;;(frame-property (selected-frame)
  438.     ;;        'window-config-stack) t    "Most recent window config"]
  439.     ;; #### Illicit knowledge?
  440.     ;; #### These don't work right - not consistent!
  441.     ;; I don't know what's wrong; perhaps `selected-frame' is wrong
  442.     ;; sometimes when this is evaluated.  Note that I even tried to
  443.     ;; kludge-fix this by calls to `set-specifier-dirty-flag' in
  444.     ;; pop-window-configuration and such.
  445.  
  446.     ;;[toolbar-next-win-icon    unpop-window-configuration
  447.     ;;(frame-property (selected-frame)
  448.     ;;    'window-config-unpop-stack) t "Undo \"Most recent window config\""]
  449.     ;; #### Illicit knowledge?
  450.  
  451.     [toolbar-file-icon        toolbar-open    t    "Open a file"]
  452.     [toolbar-folder-icon    toolbar-dired    t    "View directory"]
  453.     [toolbar-disk-icon        toolbar-save    t    "Save buffer"]
  454.     [toolbar-printer-icon    toolbar-print    t    "Print buffer"]
  455.     [toolbar-cut-icon        toolbar-cut    t    "Kill region"]
  456.     [toolbar-copy-icon        toolbar-copy    t    "Copy region"]
  457.     [toolbar-paste-icon        toolbar-paste    t    "Paste from clipboard"]
  458.     [toolbar-undo-icon        toolbar-undo    t    "Undo edit"]
  459.     [toolbar-spell-icon        toolbar-ispell    t    "Spellcheck"]
  460.     [toolbar-replace-icon    toolbar-replace    t    "Replace text"]
  461.     [toolbar-mail-icon        toolbar-mail    t    "Mail"]
  462.     [toolbar-info-icon        toolbar-info    t    "Information"]
  463.     [toolbar-compile-icon    toolbar-compile    t    "Compile"]
  464.     [toolbar-debug-icon        toolbar-debug    t    "Debug"]
  465.     [toolbar-news-icon        toolbar-news    t    "News"]
  466. )
  467.   "The initial toolbar for a buffer.")
  468.  
  469. (defun x-init-toolbar-from-resources (locale)
  470.   (x-init-specifier-from-resources
  471.    top-toolbar-height 'natnum locale
  472.    '("topToolBarHeight" . "TopToolBarHeight"))
  473.   (x-init-specifier-from-resources
  474.    bottom-toolbar-height 'natnum locale
  475.    '("bottomToolBarHeight" . "BottomToolBarHeight"))
  476.   (x-init-specifier-from-resources
  477.    left-toolbar-width 'natnum locale
  478.    '("leftToolBarWidth" . "LeftToolBarWidth"))
  479.   (x-init-specifier-from-resources
  480.    right-toolbar-width 'natnum locale
  481.    '("rightToolBarWidth" . "RightToolBarWidth")))
  482.  
  483. ;;; x-toolbar.el ends here
  484.